home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Property Editors / bdereg.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  53KB  |  1,878 lines
  1. unit BDEReg;
  2.  
  3. interface
  4.  
  5. uses
  6.   Report, RSConsts, LibHelp, Dialogs, DBLookup, FileCtrl,
  7.   SysUtils, Classes, DSDesign, Menus, DBTables, DB, DRIntf, LibIntf, DsnDBCst,
  8.   DSAttrS, DSAttrA, DBReg, DbXPlor, BDEConst, GQEDelph, ColnEdit, TblDsgn,
  9.   DsgnIntf, DBEdit, IxEdit, UpdSqlEd, FldLinks, CnColEdt, DRTable,
  10.   CustomModuleEditors,
  11.   ParentageSupport, DsnDB,
  12.   ModelViews, ModelPrimitives, DataModelViews, DataModelSupport;
  13.  
  14. type
  15.  
  16. { TTableFieldLinkProperty }
  17.  
  18.   TTableFieldLinkProperty = class(TFieldLinkProperty)
  19.   private
  20.     FTable: TTable;
  21.   protected
  22.     procedure GetFieldNamesForIndex(List: TStrings); override;
  23.     function GetIndexBased: Boolean; override;
  24.     function GetIndexDefs: TIndexDefs; override;
  25.     function GetIndexFieldNames: string; override;
  26.     function GetIndexName: string; override;
  27.     function GetMasterFields: string; override;
  28.     procedure SetIndexFieldNames(const Value: string); override;
  29.     procedure SetIndexName(const Value: string); override;
  30.     procedure SetMasterFields(const Value: string); override;
  31.   public
  32.     property IndexBased: Boolean read GetIndexBased;
  33.     property IndexDefs: TIndexDefs read GetIndexDefs;
  34.     property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
  35.     property IndexName: string read GetIndexName write SetIndexName;
  36.     property MasterFields: string read GetMasterFields write SetMasterFields;
  37.  
  38.     procedure Edit; override;
  39.   end;
  40.  
  41. const
  42.   cDefaultSessionSprigName =    '<DefaultSession>'; { do not localize }
  43.   cImpliedSessionSprigPrefix =  '<ImpliedSession>'; { do not localize }
  44.   cImpliedDatabaseSprigPrefix = '<ImpliedDatabase>'; { do not localize }
  45.  
  46. type
  47.   TSessionSprig = class(TSprigAtRoot)
  48.   public
  49.     function Name: string; override;
  50.     function Caption: string; override;
  51.     function AnyProblems: Boolean; override;
  52.   end;
  53.  
  54.   TDefaultSessionSprig = class(TSprigAtRoot)
  55.   public
  56.     function UniqueName: string; override;
  57.     function Caption: string; override;
  58.     function Transient: Boolean; override;
  59.     function ItemClass: TClass; override;
  60.   end;
  61.  
  62.   TImpliedSessionSprig = class(TSprigAtRoot)
  63.   private
  64.     FSessionName: string;
  65.   public
  66.     function UniqueName: string; override;
  67.     function Caption: string; override;
  68.     function Transient: Boolean; override;
  69.     function ItemClass: TClass; override;
  70.   end;
  71.  
  72.   TDatabaseSprig = class(TSprig)
  73.   public
  74.     function Name: string; override;
  75.     function Caption: string; override;
  76.     function AnyProblems: Boolean; override;
  77.     procedure FigureParent; override;
  78.     function DragDropTo(AItem: TSprig): Boolean; override;
  79.     function DragOverTo(AItem: TSprig): Boolean; override;
  80.     class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;
  81.   end;
  82.  
  83.   TImpliedDatabaseSprig = class(TSprig)
  84.   private
  85.     FSessionName: string;
  86.     FAlias: string;
  87.   public
  88.     function AnyProblems: Boolean; override;
  89.     function UniqueName: string; override;
  90.     function Caption: string; override;
  91.     function Transient: Boolean; override;
  92.     function ItemClass: TClass; override;
  93.     procedure FigureParent; override;
  94.     function DragDropTo(AItem: TSprig): Boolean; override;
  95.     function DragOverTo(AItem: TSprig): Boolean; override;
  96.   end;
  97.  
  98.   TBatchMoveSprig = class(TSprigAtRoot)
  99.   public
  100.     function AnyProblems: Boolean; override;
  101.     function Caption: string; override;
  102.   end;
  103.  
  104.   TUpdateSQLSprig = class(TSprigAtRoot)
  105.   public
  106.     function AnyProblems: Boolean; override;
  107.   end;
  108.  
  109.   TBDEDataSetSprig = class(TDataSetSprig)
  110.   public
  111.     function GetDSDesignerClass: TDSDesignerClass; override;
  112.   end;
  113.  
  114.   TNestedTableSprig = class(TBDEDataSetSprig)
  115.   public
  116.     class function ParentProperty: string; override;
  117.   end;
  118.  
  119.   TDBDataSetSprig = class(TBDEDataSetSprig)
  120.   public
  121.     function AnyProblems: Boolean; override;
  122.     procedure FigureParent; override;
  123.     procedure Reparent; override;
  124.     function DragDropTo(AItem: TSprig): Boolean; override;
  125.     function DragOverTo(AItem: TSprig): Boolean; override;
  126.     class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;
  127.   end;
  128.  
  129.   TTableSprig = class(TDBDataSetSprig)
  130.   public
  131.     function AnyProblems: Boolean; override;
  132.     function Caption: string; override;
  133.   end;
  134.  
  135.   TQuerySprig = class(TDBDataSetSprig)
  136.   public
  137.     function AnyProblems: Boolean; override;
  138.   end;
  139.  
  140.   TStoredProcSprig = class(TDBDataSetSprig)
  141.   public
  142.     function AnyProblems: Boolean; override;
  143.     function Caption: string; override;
  144.   end;
  145.  
  146.   TBDEDataSetIsland = class(TDataSetIsland)
  147.   end;
  148.  
  149.   TDBDataSetIsland = class(TBDEDataSetIsland)
  150.   end;
  151.  
  152.   TTableIsland = class(TDBDataSetIsland)
  153.   end;
  154.  
  155.   TTableMasterDetailBridge = class(TMasterDetailBridge)
  156.   public
  157.     function CanEdit: Boolean; override;
  158.     class function OmegaIslandClass: TIslandClass; override;
  159.     class function GetOmegaSource(AItem: TPersistent): TDataSource; override;
  160.     class procedure SetOmegaSource(AItem: TPersistent; ADataSource: TDataSource); override;
  161.     function Caption: string; override;
  162.     function Edit: Boolean; override;
  163.   end;
  164.  
  165.   TQueryIsland = class(TDBDataSetIsland)
  166.   end;
  167.  
  168.   TQueryMasterDetailBridge = class(TMasterDetailBridge)
  169.   public
  170.     class function RemoveMasterFieldsAsWell: Boolean; override;
  171.     class function OmegaIslandClass: TIslandClass; override;
  172.     class function GetOmegaSource(AItem: TPersistent): TDataSource; override;
  173.     class procedure SetOmegaSource(AItem: TPersistent; ADataSource: TDataSource); override;
  174.     function Caption: string; override;
  175.   end;
  176.  
  177. function SprigBDESessionName(const AName: string): string;
  178. function SprigBDEImpliedDatabaseName(const AName: string): string;
  179. function SprigBDEImpliedSessionName(const AName: string): string;
  180.  
  181. procedure Register;
  182.  
  183. implementation
  184.  
  185. type
  186.  
  187. { TBDEDesigner }
  188.  
  189.   TMenuItemID = (miSeparator, miRetrieve, miSave, miSaveAs, miAssociate, miUnassociate);
  190.  
  191.   TBDEDesigner = class(TDSDesigner)
  192.   private
  193.     FTableID: TTableID;
  194.     FQueryDescs: TQueryDescription;
  195.     FMenuArray: array [TMenuItemID] of TMenuItem;
  196.   protected
  197.     procedure AttributeClick(Sender: TObject);
  198.     function QualifyTableName(DatabaseName: string;
  199.       Database: TDatabase; const TableName: string): string;
  200.     function CheckAttribute(Field: TField): Boolean;
  201.     procedure GetTableDesc(var ADatabase, ATable: string);
  202.     procedure GetFieldInfo(Field: TField; var FieldID: TFieldID;
  203.       var AttrID: TAttrID);
  204.     function FindFieldInfo(Field: TField; var FieldID: TFieldID;
  205.       var AttrID: TAttrID): Boolean;
  206.     function RetrieveAttributes(Field: TField): Boolean;
  207.     function SaveAttributes(Field: TField): Boolean;
  208.     function SaveAttributesAs(Field: TField): Boolean;
  209.     function AssociateAttributes(Field: TField): Boolean;
  210.     function UnassociateAttributes(Field: TField): Boolean;
  211.   public
  212.     destructor Destroy; override;
  213.     procedure BeginCreateFields; override;
  214.     function DoCreateField(const FieldName: string; Origin: string): TField; override;
  215.     procedure EndCreateFields; override;
  216.     function GetControlClass(Field: TField): string; override;
  217.     procedure InitializeMenu(Menu: TPopupMenu); override;
  218.     procedure UpdateMenus(Menu: TPopupMenu; EditState: TEditState); override;
  219.   end;
  220.  
  221. destructor TBDEDesigner.Destroy;
  222. begin
  223.   inherited Destroy;
  224.   if DSDesign.DesignerCount <= 0 then DictionaryDeactivate;
  225. end;
  226.  
  227. function TBDEDesigner.QualifyTableName(DatabaseName: string;
  228.   Database: TDatabase; const TableName: string): string;
  229. begin
  230.   if not Assigned(Database) then
  231.     Result := QualifyTableNameByName(TDBDataset(Dataset).SessionName,
  232.       DatabaseName, TableName) else
  233.     Result := DrIntf.QualifyTableName(Database, TableName);
  234. end;
  235.  
  236. procedure TBDEDesigner.GetTableDesc(var ADatabase, ATable: string);
  237. var
  238.   Database: TDatabase;
  239. begin
  240.   ADatabase := '';
  241.   ATable := '';
  242.   if Dataset is TTable then
  243.   begin
  244.     ADatabase := TTable(Dataset).DatabaseName;
  245.     Database := TTable(Dataset).Database;
  246.     ATable := QualifyTableName(ADatabase, Database, TTable(Dataset).TableName);
  247.   end;
  248. end;
  249.  
  250. function TBDEDesigner.CheckAttribute(Field: TField): Boolean;
  251. var
  252.   FieldID: TFieldID;
  253.   AttrID: TAttrID;
  254. begin
  255.   Result := False;
  256.   if Field.AttributeSet <> '' then Exit;
  257.   FindFieldInfo(Field, FieldID, AttrID);
  258.   if not IsNullID(AttrID) then Exit;
  259.   Result := True;
  260. end;
  261.  
  262. procedure TBDEDesigner.GetFieldInfo(Field: TField; var FieldID: TFieldID;
  263.   var AttrID: TAttrID);
  264. begin
  265.   if not FindFieldInfo(Field, FieldID, AttrID) then
  266.     raise Exception.CreateResFmt(@SDSFieldNotInDict, [Field.FullName]);
  267. end;
  268.  
  269. function TBDEDesigner.FindFieldInfo(Field: TField; var FieldID: TFieldID;
  270.   var AttrID: TAttrID): Boolean;
  271. var
  272.   DatabaseName, TableName: string;
  273. begin
  274.   GetTableDesc(Databasename, TableName);
  275.   AttrID := NullAttrID;
  276.   FieldID := FindFieldID(FindTableID(FindDatabaseID(DatabaseName), TableName),
  277.     Field.FieldName);
  278.   if not IsNullID(FieldID) then
  279.     AttrID := GetAttrID(FieldID)
  280.   else if Field.AttributeSet <> '' then
  281.     AttrID := FindAttrID(Field.AttributeSet);
  282.   Result := not IsNullID(FieldID) or not IsNullID(AttrID);
  283. end;
  284.  
  285. function TBDEDesigner.RetrieveAttributes(Field: TField): Boolean;
  286. var
  287.   FieldID: TFieldID;
  288.   AttrID: TAttrID;
  289. begin
  290.   if FindFieldInfo(Field, FieldID, AttrID) then
  291.   begin
  292.     UpdateField(Field, FieldID, AttrID);
  293.     Field.AttributeSet := GetAttrName(AttrID);
  294.   end;
  295.   Result := True;
  296. end;
  297.  
  298. function TBDEDesigner.SaveAttributes(Field: TField): Boolean;
  299. var
  300.   FieldID: TFieldID;
  301.   AttrID: TAttrID;
  302. begin
  303.   Result := True;
  304.   GetFieldInfo(Field, FieldID, AttrID);
  305.   if not IsNullID(AttrID) then
  306.     UpdateAttr(Field, FieldID, AttrID)
  307.   else
  308.     Result := SaveAttributesAs(Field);
  309. end;
  310.  
  311. function TBDEDesigner.SaveAttributesAs(Field: TField): Boolean;
  312. var
  313.   DatabaseName, TableName, AttributeName: string;
  314.   FieldID: TFieldID;
  315.   AttrID: TAttrID;
  316. begin
  317.   GetTableDesc(DatabaseName, TableName);
  318.   GetFieldInfo(Field, FieldID, AttrID);
  319.   Result := SaveAttributesAsDlg(TableName, Field.FieldName, AttributeName, AttrID);
  320.   if Result then NewAttr(Field, FieldID, AttributeName, AttrID);
  321. end;
  322.  
  323. function TBDEDesigner.AssociateAttributes(Field: TField): Boolean;
  324. var
  325.   FieldID: TFieldID;
  326.   AttrID: TAttrID;
  327. begin
  328.   FindFieldInfo(Field, FieldID, AttrID);
  329.   if GetAssociateAttributes(AttrID, Result) then
  330.   begin
  331.     if not IsNullID(FieldID) then AssociateAttr(AttrID, FieldID);
  332.     UpdateField(Field, FieldID, AttrID);
  333.     Field.AttributeSet := GetAttrName(AttrID);
  334.   end;
  335. end;
  336.  
  337. function TBDEDesigner.UnassociateAttributes(Field: TField): Boolean;
  338. var
  339.   FieldID: TFieldID;
  340.   AttrID: TAttrID;
  341. begin
  342.   Field.AttributeSet := '';
  343.   FindFieldInfo(Field, FieldID, AttrID);
  344.   if not IsNullID(FieldID) then UnassociateAttr(FieldID);
  345.   Field.AttributeSet := '';
  346.   Result := True;
  347. end;
  348.  
  349. procedure TBDEDesigner.AttributeClick(Sender: TObject);
  350. var
  351.   MenuID: TMenuItemID;
  352.   Proc: TSelectionProc;
  353. begin
  354.   if Assigned(Sender) and (Sender is TComponent) then
  355.     MenuID := TMenuItemID(TComponent(Sender).Tag) else
  356.     MenuID := miSeparator;
  357.   try
  358.     case MenuID of
  359.       miRetrieve: Proc := RetrieveAttributes;
  360.       miSave: Proc := SaveAttributes;
  361.       miSaveAs: Proc := SaveAttributesAs;
  362.       miAssociate: Proc := AssociateAttributes;
  363.       miUnassociate: Proc := UnassociateAttributes;
  364.     else
  365.       Proc := nil;
  366.     end;
  367.     if Assigned(Proc) then
  368.       FieldsEditor.ForEachSelection(Proc);
  369.   finally
  370.     if MenuID in [miAssociate, miRetrieve] then
  371.       FieldsEditor.Designer.Modified;
  372.   end;
  373. end;
  374.  
  375. function TBDEDesigner.GetControlClass(Field: TField): string;
  376. var
  377.   FieldID: TFieldID;
  378.   AttrId: TAttrID;
  379. begin
  380.   if Assigned(Field) then
  381.   begin
  382.     FindFieldInfo(Field, FieldID, AttrID);
  383.     Result := DRIntf.GetControlClass(AttrID);
  384.   end else
  385.     Result := '';
  386.   if Result = '' then
  387.     Result := inherited GetControlClass(Field);
  388. end;
  389.  
  390. procedure TBDEDesigner.BeginCreateFields;
  391. var
  392.   DatabaseName, TableName: string;
  393. begin
  394.   if Dataset is TTable then
  395.   begin
  396.     GetTableDesc(DatabaseName, TableName);
  397.     FTableID := FindTableID(FindDatabaseID(DatabaseName), TableName);
  398.   end
  399.   else
  400.   if Dataset is TQuery then
  401.   begin
  402.     FQueryDescs := TQueryDescription.Create(nil);
  403.     try
  404.       FQueryDescs.Query := TQuery(Dataset);
  405.       FQueryDescs.Open;
  406.     except
  407.       FQueryDescs.Free;
  408.       FQueryDescs := nil;
  409.     end;
  410.   end;
  411.   inherited BeginCreateFields;
  412. end;
  413.  
  414. procedure TBDEDesigner.EndCreateFields;
  415. begin
  416.   FQueryDescs.Free;
  417.   FQueryDescs := nil;
  418.   FTableID := NullTableId;
  419.   inherited EndCreateFields;
  420. end;
  421.  
  422. function TBDEDesigner.DoCreateField(const FieldName: string; Origin: string): TField;
  423. var
  424.   FieldID: TFieldID;
  425.   AttrID: TAttrID;
  426.   DatabaseName: string;
  427.   TableName: string;
  428.   FldName: string;
  429.  
  430.   function NeedsBackslashing(const Name: string): Boolean;
  431.   var
  432.     N: PChar;
  433.   begin
  434.     Result := True;
  435.     N := PChar(Pointer(Name));
  436.     while N^ <> #0 do
  437.       if N^ in ['\','"'] then Exit
  438.       else if N^ in LeadBytes then Inc(N, 2)
  439.       else Inc(N);
  440.     Result := False;
  441.   end;
  442.  
  443.   function Backslash(const Name: string): string;
  444.   var
  445.     CName: array[0..1024] of Char;
  446.     N, C: PChar;
  447.   begin
  448.     N := PChar(Pointer(Name));
  449.     C := CName;
  450.     while N^ <> #0 do
  451.     begin
  452.       if N^ in ['\', '"'] then
  453.       begin
  454.         C^ := '\';
  455.         Inc(C);
  456.       end;
  457.       C^ := N^;
  458.       if N^ in LeadBytes then
  459.       begin
  460.         Inc(C);
  461.         Inc(N);
  462.         C^ := N^;
  463.       end;
  464.       Inc(C);
  465.       Inc(N);
  466.     end;
  467.     SetString(Result, CName, C - CName);
  468.   end;
  469.  
  470.   function Delimit(const Name: string): string;
  471.   begin
  472.     Result := Name;
  473.     if NeedsBackslashing(Result) then Result := Backslash(Result);
  474.     if Pos('.', Name) <> 0 then Result := '"' + Result + '"';
  475.   end;
  476.  
  477. begin
  478.   FieldID := NullFieldID;
  479.   AttrID := NullAttrID;
  480.   if Origin = '' then
  481.   begin
  482.     if DataSet is TTable then
  483.     begin
  484.       FieldID := FindFieldID(FTableID, FieldName);
  485.       AttrID := GetAttrID(FieldID);
  486.       Origin := '';
  487.     end else
  488.     if DataSet is TQuery then
  489.     try
  490.       FQueryDescs.RecNo := DataSet.FieldDefs.Find(FieldName).FieldNo;
  491.       DatabaseName := FQueryDescs['DATABASE']; { Do not localize }
  492.       TableName := FQueryDescs['TABLENAME']; { Do not localize }
  493.       FldName := FQueryDescs['FIELDNAME']; { Do not localize }
  494.       FieldID := FindFieldID(FindTableID(FindDatabaseID(DatabaseName),
  495.         QualifyTableName(DatabaseName, nil, FQueryDescs['TABLENAME'])), { Do not localize }
  496.         FQueryDescs['FIELDNAME']); { Do not localize }
  497.       AttrID := GetAttrID(FieldID);
  498.       Origin := Delimit(TableName) + '.' + Delimit(FldName);
  499.       if (TQuery(Dataset).Database = nil) or
  500.          AnsiSameText(TQuery(Dataset).DatabaseName, DatabaseName) then
  501.         Origin := Delimit(DatabaseName) + '.' + Origin;
  502.     except
  503.       FieldID := NullFieldID;
  504.       AttrID := NullAttrID;
  505.       Origin := '';
  506.     end;
  507.   end;
  508.   Result := inherited DoCreateField(FieldName, Origin);
  509.   try
  510.     if DictionaryActive then UpdateField(Result, FieldID, AttrID);
  511.   except
  512.     Result.Free;
  513.     raise;
  514.   end;
  515. end;
  516.  
  517. procedure TBDEDesigner.InitializeMenu(Menu: TPopupMenu);
  518. type
  519.   TMenuInfo = record
  520.     Name: string;
  521.     HelpContext: Integer;
  522.     Caption: string;
  523.     ShortCut: string;
  524.     Tag: TMenuItemID;
  525.   end;
  526. const
  527.   AttributeMenus: array[TMenuItemID] of TMenuInfo = (
  528.    (Name: 'N2'; HelpContext: 0; Caption: '-'; ShortCut: ''; Tag: miSeparator), { Do not localize }
  529.    (Name: 'RetrieveItem'; HelpContext: 30138; Caption: SRetrieveAttributes;{ Do not localize }
  530.     ShortCut: 'Ctrl+R'; Tag: miRetrieve),{ Do not localize }
  531.    (Name: 'UpdateItem'; HelpContext: 30139; Caption: SSaveAttributes;{ Do not localize }
  532.     ShortCut: 'Ctrl+S'; Tag: miSave),{ Do not localize }
  533.    (Name: 'SaveAttributesAsItem'; HelpContext: 30140; Caption: SSaveAttributesAs;{ Do not localize }
  534.     ShortCut: 'Ctrl+E'; Tag: miSaveAs),{ Do not localize }
  535.    (Name: 'AssociateItem'; HelpContext: 30141; Caption: SAssociateAttributes;{ Do not localize }
  536.     ShortCut: 'Ctrl+O'; Tag: miAssociate),{ Do not localize }
  537.    (Name: 'Unassociate'; HelpContext: 30142; Caption: SUnassociateAttributes;{ Do not localize }
  538.     ShortCut: 'Ctrl+U'; Tag: miUnassociate){ Do not localize }
  539.   );
  540. var
  541.   i: TMenuItemID;
  542. begin
  543.   FTableID := NullTableID;
  544.   FQueryDescs := nil;
  545.   inherited InitializeMenu(Menu);
  546.   for i := Low(AttributeMenus) to High(AttributeMenus) do
  547.   begin
  548.     FMenuArray[i] := TMenuItem.Create(nil);
  549.     FMenuArray[i].Name := AttributeMenus[i].Name;
  550.     FMenuArray[i].HelpContext := AttributeMenus[i].HelpContext;
  551.     FMenuArray[i].Caption := AttributeMenus[i].Caption;
  552.     if AttributeMenus[i].ShortCut <> '' then
  553.       FMenuArray[i].ShortCut := TextToShortCut(AttributeMenus[i].ShortCut);
  554.     FMenuArray[i].Tag := Integer(AttributeMenus[i].Tag);
  555.     FMenuArray[i].OnClick := AttributeClick;
  556.     Menu.Items.Add(FMenuArray[i]);
  557.   end;
  558. end;
  559.  
  560. procedure TBDEDesigner.UpdateMenus(Menu: TPopupMenu; EditState: TEditState);
  561. var
  562.   i: TMenuItemID;
  563.   Active: Boolean;
  564.   HasAttributes: Boolean;
  565.   Update: Boolean;
  566.   HasSelection: Boolean;
  567. begin
  568.   inherited UpdateMenus(Menu, EditState);
  569.   HasSelection := esCanCopy in EditState;
  570.   Active := DictionaryActive;
  571.   Update := HasSelection and Active;
  572.   HasAttributes := HasSelection and Update and not FieldsEditor.ForEachSelection(CheckAttribute);
  573.   for i := Low(FMenuArray) to High(FMenuArray) do
  574.     if Assigned(FMenuArray[i]) then
  575.       case i of
  576.         miRetrieve: FMenuArray[i].Enabled := HasSelection and Active;
  577.         miSave: FMenuArray[i].Enabled := HasAttributes;
  578.         miSaveAs: FMenuArray[i].Enabled := HasAttributes or (Update and (DataSet is TTable));
  579.         miAssociate: FMenuArray[i].Enabled := Update;
  580.         miUnassociate: FMenuArray[i].Enabled := HasAttributes;
  581.       end;
  582. end;
  583.  
  584. { TDBDataSetEditor }
  585.  
  586. type
  587.   TDBDataSetEditor = class(TDataSetEditor)
  588.   protected
  589.     function GetDSDesignerClass: TDSDesignerClass; override;
  590.   public
  591.     procedure ExecuteVerb(Index: Integer); override;
  592.     function GetVerb(Index: Integer): string; override;
  593.     function GetVerbCount: Integer; override;
  594.   end;
  595.  
  596. function TDBDataSetEditor.GetDSDesignerClass: TDSDesignerClass;
  597. begin
  598.   Result := TBDEDesigner;
  599. end;
  600.  
  601. procedure TDBDataSetEditor.ExecuteVerb(Index: Integer);
  602. begin
  603.   if Index <= inherited GetVerbCount - 1 then
  604.     inherited ExecuteVerb(Index) else
  605.   begin
  606.     Dec(Index, inherited GetVerbCount);
  607.     case Index of
  608.       0: ExploreDataset(TDBDataset(Component));
  609.     end;
  610.   end;
  611. end;
  612.  
  613. function TDBDataSetEditor.GetVerb(Index: Integer): string;
  614. begin
  615.   if Index <= inherited GetVerbCount - 1 then
  616.     Result := inherited GetVerb(Index) else
  617.   begin
  618.     Dec(Index, inherited GetVerbCount);
  619.     case Index of
  620.       0: Result := SExplore;
  621.     end;
  622.   end;
  623. end;
  624.  
  625. function TDBDataSetEditor.GetVerbCount: Integer;
  626. begin
  627.   Result := inherited GetVerbCount + 1;
  628. end;
  629.  
  630. { TQueryEditor }
  631.  
  632. type
  633.   TQueryEditor = class(TDBDataSetEditor)
  634.   public
  635.     procedure ExecuteVerb(Index: Integer); override;
  636.     function GetVerb(Index: Integer): string; override;
  637.     function GetVerbCount: Integer; override;
  638.   end;
  639.  
  640. procedure TQueryEditor.ExecuteVerb(Index: Integer);
  641. var
  642.   Database: TDatabase;
  643.   Query: TQuery;
  644. begin
  645.   if Index < inherited GetVerbCount then
  646.     inherited ExecuteVerb(Index) else
  647.   begin
  648.     Query := Component as TQuery;
  649.     Dec(Index, inherited GetVerbCount);
  650.     case Index of
  651.       0: Query.ExecSQL;
  652.       1:
  653.       if GQELoaded then
  654.       begin
  655.         Database := Query.OpenDatabase;
  656.         try
  657.           BuildQuery(Query);
  658.         finally
  659.           Query.CloseDatabase(Database);
  660.         end;
  661.         if Designer <> nil then Designer.Modified;
  662.       end;
  663.     end;
  664.   end;
  665. end;
  666.  
  667. function TQueryEditor.GetVerb(Index: Integer): string;
  668. begin
  669.   if Index < inherited GetVerbCount then
  670.     Result := inherited GetVerb(Index) else
  671.   begin
  672.     Dec(Index, inherited GetVerbCount);
  673.     case Index of
  674.       0: Result := SExecute;
  675.       1: if GQELoaded then Result := SGQEVerb;
  676.     end;
  677.   end;
  678. end;
  679.  
  680. function TQueryEditor.GetVerbCount: Integer;
  681. begin
  682.   Result := inherited GetVerbCount + 1 + Ord(LoadGQE);
  683. end;
  684.  
  685. { TQueryParamsProperty }
  686.  
  687. type
  688.   TQueryParamsProperty = class(TCollectionProperty)
  689.   public
  690.     function GetColOptions: TColOptions; override;
  691.   end;
  692.  
  693. function TQueryParamsProperty.GetColOptions: TColOptions;
  694. begin
  695.   Result := [];
  696. end;
  697.  
  698. { TStoredProcEditor }
  699.  
  700. type
  701.   TStoredProcEditor = class(TDBDataSetEditor)
  702.   public
  703.     procedure ExecuteVerb(Index: Integer); override;
  704.     function GetVerb(Index: Integer): string; override;
  705.     function GetVerbCount: Integer; override;
  706.   end;
  707.  
  708. procedure TStoredProcEditor.ExecuteVerb(Index: Integer);
  709. begin
  710.   if Index < inherited GetVerbCount then
  711.     inherited ExecuteVerb(Index) else
  712.   begin
  713.     Dec(Index, inherited GetVerbCount);
  714.     if Index = 0 then (Component as TStoredProc).ExecProc;
  715.   end;
  716. end;
  717.  
  718. function TStoredProcEditor.GetVerb(Index: Integer): string;
  719. begin
  720.   if Index < inherited GetVerbCount then
  721.     Result := inherited GetVerb(Index) else
  722.   begin
  723.     Dec(Index, inherited GetVerbCount);
  724.     if Index = 0 then Result := SExecute;
  725.   end;
  726. end;
  727.  
  728. function TStoredProcEditor.GetVerbCount: Integer;
  729. begin
  730.   Result := inherited GetVerbCount + 1;
  731. end;
  732.  
  733. { TStoredProcParamsProperty }
  734.  
  735. type
  736.   TStoredProcParamsProperty = class(TCollectionProperty)
  737.   public
  738.     procedure Edit; override;
  739.   end;
  740.  
  741. procedure TStoredProcParamsProperty.Edit;
  742. var
  743.   StoredProc: TStoredProc;
  744.   Params: TParams;
  745. begin
  746.   StoredProc := (GetComponent(0) as TStoredProc);
  747.   Params := TParams.Create(nil);
  748.   try
  749.     StoredProc.CopyParams(Params);
  750.   finally
  751.     Params.Free;
  752.   end;
  753.   inherited Edit;
  754. end;
  755.  
  756. { TTableEditor }
  757.  
  758. function IsDatabaseOpen(DataSet: TDBDataSet): Boolean;
  759. var
  760.   Session: TSession;
  761.   DB: TDatabase;
  762. begin
  763.   Result := False;
  764.   with DataSet do
  765.   begin
  766.     Session := Sessions.FindSession(SessionName);
  767.     if Session <> nil then
  768.     begin
  769.       DB := Session.FindDatabase(DatabaseName);
  770.       Result := (DB <> nil) and DB.Connected;
  771.     end;
  772.   end;
  773. end;
  774.  
  775. type
  776.   TTableEditor = class(TDBDataSetEditor)
  777.   private
  778.     FActions: TTableDesignActions;
  779.     procedure UpdateActions;
  780.     function IndexToAction(Index: Integer): TTableDesignAction;
  781.   public
  782.     procedure ExecuteVerb(Index: Integer); override;
  783.     function GetVerb(Index: Integer): string; override;
  784.     function GetVerbCount: Integer; override;
  785.   end;
  786.  
  787. procedure TTableEditor.UpdateActions;
  788. const
  789.   ExistsActions: array [Boolean] of TTableDesignActions =
  790.     ([tdCreate, tdUpdate], [tdDelete, tdUpdate, tdRename]);
  791. begin
  792.   FActions := [];
  793.   if IsDatabaseOpen(TTable(Component)) then
  794.   try
  795.     FActions := ExistsActions[TTable(Component).Exists];
  796.     if (tdCreate in FActions) and (TTable(Component).FieldDefs.Count = 0) then
  797.       Exclude(FActions, tdCreate);
  798.     if (tdUpdate in FActions) and (TTable(Component).TableName = '') then
  799.       Exclude(FActions, tdUpdate);
  800.   except
  801.   end;
  802. end;
  803.  
  804. function TTableEditor.IndexToAction(Index: Integer): TTableDesignAction;
  805. begin
  806.   for Result := Low(TTableDesignAction) to High(TTableDesignAction) do
  807.     if Result in FActions then if Index = 0 then Exit else Dec(Index);
  808.   Result := tdCreate; // Error
  809. end;
  810.  
  811. procedure TTableEditor.ExecuteVerb(Index: Integer);
  812. var
  813.   I: Integer;
  814. begin
  815.   I := inherited GetVerbCount;
  816.   if Index < I then inherited
  817.   else if TableDesigner(TTable(Component), IndexToAction(Index - I)) then
  818.     Designer.Modified;
  819. end;
  820.  
  821. function TTableEditor.GetVerb(Index: Integer): string;
  822. var
  823.   I: Integer;
  824. begin
  825.   I := inherited GetVerbCount;
  826.   if Index < I then
  827.     Result := inherited GetVerb(Index) else
  828.     Result := TableDesignMenu[IndexToAction(Index - I)];
  829. end;
  830.  
  831. function TTableEditor.GetVerbCount: Integer;
  832. var
  833.   T: TTableDesignAction;
  834. begin
  835.   Result := inherited GetVerbCount;
  836.   UpdateActions;
  837.   for T := Low(TableDesignMenu) to High(TableDesignMenu) do
  838.     if T in FActions then Inc(Result);
  839. end;
  840.  
  841. { TDatabaseEditor }
  842.  
  843. type
  844.   TDatabaseEditor = class(TComponentEditor)
  845.   public
  846.     procedure ExecuteVerb(Index: Integer); override;
  847.     function GetVerb(Index: Integer): string; override;
  848.     function GetVerbCount: Integer; override;
  849.   end;
  850.  
  851. procedure TDatabaseEditor.ExecuteVerb(Index: Integer);
  852. begin
  853.   case Index of
  854.     0: if EditDatabase(TDatabase(Component)) then Designer.Modified;
  855.     1: ExploreDatabase(TDatabase(Component));
  856.   end;
  857. end;
  858.  
  859. function TDatabaseEditor.GetVerb(Index: Integer): string;
  860. begin
  861.   case Index of
  862.     0: Result := SDatabaseEditor;
  863.     1: Result := SExplore;
  864.   end;
  865. end;
  866.  
  867. function TDatabaseEditor.GetVerbCount: Integer;
  868. begin
  869.   Result := 2;
  870. end;
  871.  
  872. { TBatchMoveEditor }
  873.  
  874. type
  875.   TBatchMoveEditor = class(TDefaultEditor)
  876.   public
  877.     procedure ExecuteVerb(Index: Integer); override;
  878.     function GetVerb(Index: Integer): string; override;
  879.     function GetVerbCount: Integer; override;
  880.   end;
  881.  
  882. procedure TBatchMoveEditor.ExecuteVerb(Index: Integer);
  883. begin
  884.   TBatchMove(Component).Execute;
  885. end;
  886.  
  887. function TBatchMoveEditor.GetVerb(Index: Integer): string;
  888. begin
  889.   Result := SBatchExecute;
  890. end;
  891.  
  892. function TBatchMoveEditor.GetVerbCount: Integer;
  893. begin
  894.   Result := 1;
  895. end;
  896.  
  897. { TSessionNameProperty }
  898.  
  899. type
  900.   TSessionNameProperty = class(TDBStringProperty)
  901.   public
  902.     procedure GetValueList(List: TStrings); override;
  903.   end;
  904.  
  905. procedure TSessionNameProperty.GetValueList(List: TStrings);
  906. begin
  907.   Sessions.GetSessionNames(List);
  908. end;
  909.  
  910. { TDatabaseNameProperty }
  911.  
  912. type
  913.   TDatabaseNameProperty = class(TDBStringProperty)
  914.   public
  915.     procedure GetValueList(List: TStrings); override;
  916.   end;
  917.  
  918. procedure TDatabaseNameProperty.GetValueList(List: TStrings);
  919. begin
  920.   (GetComponent(0) as TDBDataSet).DBSession.GetDatabaseNames(List);
  921. end;
  922.  
  923. { TAliasNameProperty }
  924.  
  925. type
  926.   TAliasNameProperty = class(TDBStringProperty)
  927.   public
  928.     procedure GetValueList(List: TStrings); override;
  929.   end;
  930.  
  931. procedure TAliasNameProperty.GetValueList(List: TStrings);
  932. begin
  933.   (GetComponent(0) as TDatabase).Session.GetAliasNames(List);
  934. end;
  935.  
  936. { TDriverNameProperty }
  937.  
  938. type
  939.   TDriverNameProperty = class(TDBStringProperty)
  940.   public
  941.     procedure GetValueList(List: TStrings); override;
  942.   end;
  943.  
  944. procedure TDriverNameProperty.GetValueList(List: TStrings);
  945. begin
  946.   (GetComponent(0) as TDatabase).Session.GetDriverNames(List);
  947. end;
  948.  
  949. { TTableNameProperty }
  950.  
  951. type
  952.   TTableNameProperty = class(TDBStringProperty)
  953.   public
  954.     function AutoFill: Boolean; override;
  955.     procedure GetValueList(AList: TStrings); override;
  956.   end;
  957.  
  958. function TTableNameProperty.AutoFill: Boolean;
  959. begin
  960.   Result := IsDatabaseOpen(GetComponent(0) as TDBDataSet);
  961. end;
  962.  
  963. procedure TTableNameProperty.GetValueList(AList: TStrings);
  964. const
  965.   Masks: array[TTableType] of string[5] = ('', '*.DB', '*.DBF', '*.DBF', '*.TXT'); { Do not localize }
  966. begin
  967.   with GetComponent(0) as TTable do
  968.     DBSession.GetTableNames(DatabaseName, Masks[TableType],
  969.       TableType = ttDefault, False, AList);
  970. end;
  971.  
  972. { TProcedureNameProperty }
  973.  
  974. type
  975.   TProcedureNameProperty = class(TDBStringProperty)
  976.   public
  977.     function AutoFill: Boolean; override;
  978.     procedure GetValueList(List: TStrings); override;
  979.   end;
  980.  
  981. function TProcedureNameProperty.AutoFill: Boolean;
  982. begin
  983.   Result := (GetComponent(0) as TDBDataSet).Active;
  984. end;
  985.  
  986. procedure TProcedureNameProperty.GetValueList(List: TStrings);
  987. var
  988.   DBDataSet: TDBDataSet;
  989. begin
  990.   DBDataSet := GetComponent(0) as TDBDataSet;
  991.   DBDataSet.DBSession.GetStoredProcNames(DBDataSet.DatabaseName, List);
  992. end;
  993. { TIndexFilesProperty }
  994.  
  995. type
  996.   TIndexFilesProperty = class(TPropertyEditor)
  997.   public
  998.     function GetAttributes: TPropertyAttributes; override;
  999.     procedure Edit; override;
  1000.     function GetValue: string; override;
  1001.   end;
  1002.  
  1003. function TIndexFilesProperty.GetAttributes: TPropertyAttributes;
  1004. begin
  1005.   Result := [paDialog, paReadOnly];
  1006. end;
  1007.  
  1008. function TIndexFilesProperty.GetValue: string;
  1009. begin
  1010.   Result := Format('(%s)', [TIndexFiles.ClassName]); { Do not localize }
  1011. end;
  1012.  
  1013. procedure TIndexFilesProperty.Edit;
  1014. var
  1015.   List: TStringList;
  1016.   Table: TTable;
  1017.   I: Integer;
  1018.   IndexFile: string;
  1019. begin
  1020.   Table := GetComponent(0) as TTable;
  1021.   List := TStringList.Create;
  1022.   try
  1023.     List.Assign(Table.IndexFiles);
  1024.     if EditIndexFiles(Table, List) then
  1025.     begin
  1026.       for I := 0 to List.Count - 1 do
  1027.       begin
  1028.         IndexFile := List[I];
  1029.         with Table.IndexFiles do
  1030.           if IndexOf(IndexFile) = -1 then Add(IndexFile);
  1031.       end;
  1032.       for I := Table.IndexFiles.Count - 1 downto 0 do
  1033.       begin
  1034.         IndexFile := Table.IndexFiles[I];
  1035.         with Table.IndexFiles do
  1036.           if List.IndexOf(IndexFile) = -1 then Delete(IndexOf(IndexFile));
  1037.       end;
  1038.       Modified;
  1039.     end;
  1040.   finally
  1041.     List.Free;
  1042.   end;
  1043. end;
  1044.  
  1045. { TUpdateSQLEditor }
  1046.  
  1047. type
  1048.   TUpdateSQLEditor = class(TComponentEditor)
  1049.   public
  1050.     procedure ExecuteVerb(Index: Integer); override;
  1051.     function GetVerb(Index: Integer): string; override;
  1052.     function GetVerbCount: Integer; override;
  1053.   end;
  1054.  
  1055. procedure TUpdateSQLEditor.ExecuteVerb(Index: Integer);
  1056. begin
  1057.   if EditUpdateSQL(TUpdateSQL(Component)) then Designer.Modified;
  1058. end;
  1059.  
  1060. function TUpdateSQLEditor.GetVerb(Index: Integer): string;
  1061. begin
  1062.   Result := SUpdateSQLEditor;
  1063. end;
  1064.  
  1065. function TUpdateSQLEditor.GetVerbCount: Integer;
  1066. begin
  1067.   Result := 1;
  1068. end;
  1069.  
  1070. { TTableFieldLinkProperty }
  1071.  
  1072. procedure TTableFieldLinkProperty.Edit;
  1073. var
  1074.   Table: TTable;
  1075. begin
  1076.   Table := DataSet as TTable;
  1077.   FTable := TTable.Create(nil);
  1078.   try
  1079.     FTable.SessionName := Table.SessionName;
  1080.     FTable.DatabaseName := Table.DatabaseName;
  1081.     FTable.TableName := Table.TableName;
  1082.     if Table.IndexFieldNames <> '' then
  1083.       FTable.IndexFieldNames := Table.IndexFieldNames else
  1084.       FTable.IndexName := Table.IndexName;
  1085.     FTable.MasterFields := Table.MasterFields;
  1086.     FTable.Open;
  1087.     inherited Edit;
  1088.     if Changed then
  1089.     begin
  1090.       Table.MasterFields := FTable.MasterFields;
  1091.       if FTable.IndexFieldNames <> '' then
  1092.         Table.IndexFieldNames := FTable.IndexFieldNames else
  1093.         Table.IndexName := FTable.IndexName;
  1094.     end;
  1095.   finally
  1096.     FTable.Free;
  1097.   end;
  1098. end;
  1099.  
  1100. procedure TTableFieldLinkProperty.GetFieldNamesForIndex(List: TStrings);
  1101. var
  1102.   i: Integer;
  1103. begin
  1104.   for i := 0 to FTable.IndexFieldCount - 1 do
  1105.     List.Add(FTable.IndexFields[i].FieldName);
  1106. end;
  1107.  
  1108. function TTableFieldLinkProperty.GetIndexBased: Boolean;
  1109. begin
  1110.   Result := not IProviderSupport(FTable).PSIsSQLBased;
  1111. end;
  1112.  
  1113. function TTableFieldLinkProperty.GetIndexDefs: TIndexDefs;
  1114. begin
  1115.   Result := FTable.IndexDefs;
  1116. end;
  1117.  
  1118. function TTableFieldLinkProperty.GetIndexFieldNames: string;
  1119. begin
  1120.   Result := FTable.IndexFieldNames;
  1121. end;
  1122.  
  1123. function TTableFieldLinkProperty.GetIndexName: string;
  1124. begin
  1125.   Result := FTable.IndexName;
  1126. end;
  1127.  
  1128. function TTableFieldLinkProperty.GetMasterFields: string;
  1129. begin
  1130.   Result := FTable.MasterFields;
  1131. end;
  1132.  
  1133. procedure TTableFieldLinkProperty.SetIndexFieldNames(const Value: string);
  1134. begin
  1135.   FTable.IndexFieldNames := Value;
  1136. end;
  1137.  
  1138. procedure TTableFieldLinkProperty.SetIndexName(const Value: string);
  1139. begin
  1140.   if Value = SPrimary then
  1141.     FTable.IndexName := '' else
  1142.     FTable.IndexName := Value;
  1143. end;
  1144.  
  1145. procedure TTableFieldLinkProperty.SetMasterFields(const Value: string);
  1146. begin
  1147.   FTable.MasterFields := Value;
  1148. end;
  1149.  
  1150.  
  1151. type
  1152.   TReportEditor = class(TComponentEditor)
  1153.   public
  1154.     procedure Edit; override;
  1155.     procedure ExecuteVerb(Index: Integer); override;
  1156.     function GetVerb(Index: Integer): string; override;
  1157.     function GetVerbCount: Integer; override;
  1158.   end;
  1159.  
  1160.   TReportDirProperty = class(TPropertyEditor)
  1161.   public
  1162.     function GetValue: string; override;
  1163.     procedure SetValue(const Value: string); override;
  1164.     function GetAttributes: TPropertyAttributes; override;
  1165.     procedure Edit; override;
  1166.   end;
  1167.  
  1168.   TReportNameProperty = class(TPropertyEditor)
  1169.   public
  1170.     function GetValue: string; override;
  1171.     procedure SetValue(const Value: string); override;
  1172.     function GetAttributes: TPropertyAttributes; override;
  1173.     procedure Edit; override;
  1174.   end;
  1175.  
  1176. { TReportEditor }
  1177.  
  1178. procedure TReportEditor.Edit;
  1179. begin
  1180.   TReport(Component).Run;
  1181. end;
  1182.  
  1183. procedure TReportEditor.ExecuteVerb(Index: Integer);
  1184. begin
  1185.   if Index = 0 then Edit;
  1186. end;
  1187.  
  1188. function TReportEditor.GetVerb(Index: Integer): string;
  1189. begin
  1190.   Result := SReportVerb;
  1191. end;
  1192.  
  1193. function TReportEditor.GetVerbCount: Integer;
  1194. begin
  1195.   Result := 1;
  1196. end;
  1197.  
  1198. { TReportDirProperty }
  1199.  
  1200. function TReportDirProperty.GetValue: string;
  1201. begin
  1202.   Result := (GetComponent(0) as TReport).ReportDir;
  1203. end;
  1204.  
  1205. procedure TReportDirProperty.SetValue(const Value: string);
  1206. begin
  1207.   (GetComponent(0) as TReport).ReportDir := Value;
  1208.   Modified;
  1209. end;
  1210.  
  1211. function TReportDirProperty.GetAttributes: TPropertyAttributes;
  1212. begin
  1213.   Result := [paDialog, paMultiSelect];
  1214. end;
  1215.  
  1216. procedure TReportDirProperty.Edit;
  1217. var
  1218.   FilePath: string;
  1219. begin
  1220.   FilePath := '';
  1221.   if SelectDirectory(FilePath, [], hcDSelectReportDir) then
  1222.   begin
  1223.     if AnsiLastChar(FilePath)^ <> '\' then FilePath := FilePath + '\';
  1224.     SetValue(FilePath);
  1225.   end;
  1226. end;
  1227.  
  1228. { TReportNameProperty }
  1229.  
  1230. function TReportNameProperty.GetValue: string;
  1231. begin
  1232.   Result := (GetComponent(0) as TReport).ReportName;
  1233. end;
  1234.  
  1235. procedure TReportNameProperty.SetValue(const Value: string);
  1236. begin
  1237.   (GetComponent(0) as TReport).ReportName := Value;
  1238.   Modified;
  1239. end;
  1240.  
  1241. function TReportNameProperty.GetAttributes: TPropertyAttributes;
  1242. begin
  1243.   Result := [paDialog, paMultiSelect];
  1244. end;
  1245.  
  1246. procedure TReportNameProperty.Edit;
  1247. var                                                       
  1248.   Dialog: TOpenDialog;
  1249.   FilePath: string;
  1250. begin
  1251.   Dialog := TOpenDialog.Create(nil);
  1252.   try
  1253.     with Dialog do
  1254.     begin
  1255.       DefaultExt := 'rpt';
  1256.       Filter := SReportFilter;
  1257.       if Execute then
  1258.         with GetComponent(0) as TReport do
  1259.         begin
  1260.           FileName := FileName;
  1261.           FilePath := ExtractFilePath(FileName);
  1262.           ReportDir := FilePath;
  1263.           ReportName := ExtractFileName(FileName);
  1264.           Modified;
  1265.         end;
  1266.     end;
  1267.   finally
  1268.     Dialog.Free;
  1269.   end;
  1270. end;
  1271.  
  1272. function SprigBDESessionName(const AName: string): string;
  1273. begin
  1274.   Result := AName;
  1275.   if (Result = '') or
  1276.      AnsiSameText(Result, Session.SessionName) then
  1277.     Result := cDefaultSessionSprigName;
  1278. end;
  1279.  
  1280. function SprigBDEImpliedDatabaseName(const AName: string): string;
  1281. begin
  1282.   Result := Format('%s.%s', [cImpliedDatabaseSprigPrefix, AName]); { do not localize }
  1283. end;
  1284.  
  1285. function SprigBDEImpliedSessionName(const AName: string): string;
  1286. begin
  1287.   Result := Format('%s.%s', [cImpliedSessionSprigPrefix, AName]); { do not localize }
  1288. end;
  1289.  
  1290. { TDBDataSetSprig }
  1291.  
  1292. function TDBDataSetSprig.AnyProblems: Boolean;
  1293. begin
  1294.   Result := inherited AnyProblems or
  1295.             (TDBDataSet(Item).DatabaseName = '');
  1296. end;
  1297.  
  1298. procedure TDBDataSetSprig.FigureParent;
  1299. var
  1300.   vSessionName: string;
  1301.   vSession, vDatabase: TSprig;
  1302. begin
  1303.   with TDBDataSet(Item) do
  1304.   begin
  1305.     // find real or default session
  1306.     vSessionName := SprigBDESessionName(SessionName);
  1307.     vSession := Root.Find(vSessionName, False);
  1308.  
  1309.     // if not found see if its the default session
  1310.     if (vSession = nil) and
  1311.        (vSessionName = cDefaultSessionSprigName) then
  1312.       vSession := Root.Add(TDefaultSessionSprig.Create(nil));
  1313.  
  1314.     // still not found, try for an implied session
  1315.     if vSession = nil then
  1316.     begin
  1317.       vSession := Root.Find(SprigBDEImpliedSessionName(SessionName), False);
  1318.  
  1319.       // if not make an implied session
  1320.       if vSession = nil then
  1321.       begin
  1322.         vSession := Root.Add(TImpliedSessionSprig.Create(nil));
  1323.         TImpliedSessionSprig(vSession).FSessionName := SessionName;
  1324.       end;
  1325.     end;
  1326.  
  1327.     // find data base under session
  1328.     vDatabase := vSession.Find(DatabaseName, False);
  1329.  
  1330.     // if not find a database alias
  1331.     if vDatabase = nil then
  1332.     begin
  1333.       vDatabase := vSession.Find(SprigBDEImpliedDatabaseName(DatabaseName), False);
  1334.  
  1335.       // if not make a database alias
  1336.       if vDatabase = nil then
  1337.       begin
  1338.         vDatabase := vSession.Add(TImpliedDatabaseSprig.Create(nil));
  1339.         TImpliedDatabaseSprig(vDatabase).FAlias := DatabaseName;
  1340.         TImpliedDatabaseSprig(vDatabase).FSessionName := SessionName;
  1341.       end;
  1342.     end;
  1343.  
  1344.     // set parent to the database
  1345.     vDatabase.Add(Self);
  1346.   end;
  1347. end;
  1348.  
  1349. function TDBDataSetSprig.DragDropTo(AItem: TSprig): Boolean;
  1350. begin
  1351.   if AItem is TImpliedDatabaseSprig then
  1352.   begin
  1353.     Result := not AnsiSameText(TImpliedDatabaseSprig(AItem).FAlias, TDBDataSet(Item).DatabaseName) or
  1354.               not AnsiSameText(TImpliedDatabaseSprig(AItem).FSessionName, TDBDataSet(Item).SessionName);
  1355.     if Result then
  1356.     begin
  1357.       TDBDataSet(Item).DatabaseName := TImpliedDatabaseSprig(AItem).FAlias;
  1358.       TDBDataSet(Item).SessionName := TImpliedDatabaseSprig(AItem).FSessionName;
  1359.     end;
  1360.   end
  1361.   else if AItem is TDatabaseSprig then
  1362.   begin
  1363.     Result := not AnsiSameText(TDatabase(AItem.Item).DatabaseName, TDBDataSet(Item).DatabaseName) or
  1364.               not AnsiSameText(TDatabase(AItem.Item).SessionName, TDBDataSet(Item).SessionName);
  1365.     if Result then
  1366.     begin
  1367.       TDBDataSet(Item).DatabaseName := TDatabase(AItem.Item).DatabaseName;
  1368.       TDBDataSet(Item).SessionName := TDatabase(AItem.Item).SessionName;
  1369.     end;
  1370.   end
  1371.   else
  1372.     Result := False;
  1373. end;
  1374.  
  1375. function TDBDataSetSprig.DragOverTo(AItem: TSprig): Boolean;
  1376. begin
  1377.   Result := ((AItem is TDatabaseSprig) and (TDatabase(AItem.Item).DatabaseName <> '')) or
  1378.             (AItem is TImpliedDatabaseSprig);
  1379. end;
  1380.  
  1381. class function TDBDataSetSprig.PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean;
  1382. begin
  1383.   Result := ((AParent is TDatabaseSprig) and (TDatabase(AParent.Item).DatabaseName <> '')) or
  1384.             (AParent is TImpliedDatabaseSprig);
  1385. end;
  1386.  
  1387. procedure TDBDataSetSprig.Reparent;
  1388. begin
  1389.   if Parent is TDatabaseSprig then
  1390.     TDBDataSet(Item).SessionName := TDatabase(Parent.Item).SessionName
  1391.   else if Parent is TImpliedDatabaseSprig then
  1392.     TDBDataSet(Item).SessionName := TImpliedDatabaseSprig(Parent).FSessionName;
  1393. end;
  1394.  
  1395. { TSessionSprig }
  1396.  
  1397. function TSessionSprig.Name: string;
  1398. begin
  1399.   Result := TSession(Item).SessionName;
  1400. end;
  1401.  
  1402. function TSessionSprig.AnyProblems: Boolean;
  1403. begin
  1404.   Result := TSession(Item).SessionName = '';
  1405. end;
  1406.  
  1407. function TSessionSprig.Caption: string;
  1408. begin
  1409.   Result := CaptionFor(Name, UniqueName);
  1410. end;
  1411.  
  1412. { TDefaultSessionSprig }
  1413.  
  1414. function TDefaultSessionSprig.Caption: string;
  1415. begin
  1416.   Result := CaptionFor(Session.SessionName, Copy(Session.ClassName, 2, 255));
  1417. end;
  1418.  
  1419. function TDefaultSessionSprig.ItemClass: TClass;
  1420. begin
  1421.   Result := TSession;
  1422. end;
  1423.  
  1424. function TDefaultSessionSprig.UniqueName: string;
  1425. begin
  1426.   Result := cDefaultSessionSprigName;
  1427. end;
  1428.  
  1429. function TDefaultSessionSprig.Transient: Boolean;
  1430. begin
  1431.   Result := True;
  1432. end;
  1433.  
  1434. { TImpliedSessionSprig }
  1435.  
  1436. function TImpliedSessionSprig.Caption: string;
  1437. begin
  1438.   Result := CaptionFor(FSessionName, 'Implied Session'); { do not localize }
  1439. end;
  1440.  
  1441. function TImpliedSessionSprig.ItemClass: TClass;
  1442. begin
  1443.   Result := TSession;
  1444. end;
  1445.  
  1446. function TImpliedSessionSprig.UniqueName: string;
  1447. begin
  1448.   Result := SprigBDEImpliedSessionName(FSessionName);
  1449. end;
  1450.  
  1451. function TImpliedSessionSprig.Transient: Boolean;
  1452. begin
  1453.   Result := True;
  1454. end;
  1455.  
  1456. { TDatabaseSprig }
  1457.  
  1458. function TDatabaseSprig.Name: string;
  1459. begin
  1460.   Result := TDatabase(Item).DatabaseName;
  1461. end;
  1462.  
  1463. function TDatabaseSprig.AnyProblems: Boolean;
  1464. begin
  1465.   Result := TDatabase(Item).DatabaseName = '';
  1466. end;
  1467.  
  1468. function TDatabaseSprig.Caption: string;
  1469. var
  1470.   vName: string;
  1471. begin
  1472.   vName := Name;
  1473.   if TDatabase(Item).AliasName <> '' then
  1474.     Result := Format('%s:%s', [vName, TDatabase(Item).AliasName]); { Do not localize }
  1475.   Result := CaptionFor(vName, UniqueName);
  1476. end;
  1477.  
  1478. procedure TDatabaseSprig.FigureParent;
  1479. var
  1480.   vSessionName: string;
  1481.   vSession: TSprig;
  1482. begin
  1483.   with TDatabase(Item) do
  1484.   begin
  1485.     // find real or default session
  1486.     vSessionName := SprigBDESessionName(SessionName);
  1487.     vSession := Root.Find(vSessionName, False);
  1488.  
  1489.     // if not found see if its the default session
  1490.     if (vSession = nil) and
  1491.        (vSessionName = cDefaultSessionSprigName) then
  1492.       vSession := Root.Add(TDefaultSessionSprig.Create(nil));
  1493.  
  1494.     // still not found, try for an implied session
  1495.     if vSession = nil then
  1496.     begin
  1497.       vSession := Root.Find(SprigBDEImpliedSessionName(SessionName), False);
  1498.  
  1499.       // if not make an implied session
  1500.       if vSession = nil then
  1501.       begin
  1502.         vSession := Root.Add(TImpliedSessionSprig.Create(nil));
  1503.         TImpliedSessionSprig(vSession).FSessionName := SessionName;
  1504.       end;
  1505.     end;
  1506.  
  1507.     // well put it
  1508.     vSession.Add(Self);
  1509.   end;
  1510. end;
  1511.  
  1512. function TDatabaseSprig.DragDropTo(AItem: TSprig): Boolean;
  1513. begin
  1514.   if AItem is TSessionSprig then
  1515.   begin
  1516.     Result := not AnsiSameText(TSession(AItem.Item).SessionName, TDatabase(Item).SessionName);
  1517.     if Result then
  1518.       TDatabase(Item).SessionName := TSession(AItem.Item).SessionName;
  1519.   end
  1520.   else if AItem is TImpliedSessionSprig then
  1521.   begin
  1522.     Result := not AnsiSameText(TImpliedSessionSprig(AItem).FSessionName, TDatabase(Item).SessionName);
  1523.     if Result then
  1524.       TDatabase(Item).SessionName := TImpliedSessionSprig(AItem).FSessionName;
  1525.   end
  1526.   else if AItem is TDefaultSessionSprig then
  1527.   begin
  1528.     Result := not AnsiSameText(TDatabase(Item).SessionName, Session.SessionName) or
  1529.               (TDatabase(Item).SessionName <> '');
  1530.     if Result then
  1531.       TDatabase(Item).SessionName := '';
  1532.   end
  1533.   else
  1534.     Result := False;
  1535.   ReparentChildren;
  1536. end;
  1537.  
  1538. function TDatabaseSprig.DragOverTo(AItem: TSprig): Boolean;
  1539. begin
  1540.   Result := ((AItem is TSessionSprig) and (TSession(AItem.Item).SessionName <> '')) or
  1541.             (AItem is TImpliedSessionSprig) or
  1542.             (AItem is TDefaultSessionSprig);
  1543. end;
  1544.  
  1545. class function TDatabaseSprig.PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean;
  1546. begin
  1547.   Result := ((AParent is TSessionSprig) and (TSession(AParent.Item).SessionName <> '')) or
  1548.             (AParent is TImpliedSessionSprig) or
  1549.             (AParent is TDefaultSessionSprig);
  1550. end;
  1551.  
  1552. { TImpliedDatabaseSprig }
  1553.  
  1554. function TImpliedDatabaseSprig.AnyProblems: Boolean;
  1555. begin
  1556.   Result := FAlias = '';
  1557. end;
  1558.  
  1559. function TImpliedDatabaseSprig.Caption: string;
  1560. begin
  1561.   Result := CaptionFor(FAlias, 'Alias'); { Do not localize }
  1562. end;
  1563.  
  1564. function TImpliedDatabaseSprig.DragDropTo(AItem: TSprig): Boolean;
  1565. begin
  1566.   if AItem is TSessionSprig then
  1567.   begin
  1568.     Result := not AnsiSameText(TSession(AItem.Item).SessionName, FSessionName);
  1569.     if Result then
  1570.       FSessionName := TSession(AItem.Item).SessionName;
  1571.   end
  1572.   else if AItem is TImpliedSessionSprig then
  1573.   begin
  1574.     Result := not AnsiSameText(TImpliedSessionSprig(AItem).FSessionName, FSessionName);
  1575.     if Result then
  1576.       FSessionName := TImpliedSessionSprig(AItem).FSessionName;
  1577.   end
  1578.   else if AItem is TDefaultSessionSprig then
  1579.   begin
  1580.     Result := not AnsiSameText(TDatabase(Item).SessionName, Session.SessionName) or
  1581.               (TDatabase(Item).SessionName <> '');
  1582.     if Result then
  1583.       TDatabase(Item).SessionName := '';
  1584.   end
  1585.   else
  1586.     Result := False;
  1587.   Reparent;
  1588. end;
  1589.  
  1590. function TImpliedDatabaseSprig.DragOverTo(AItem: TSprig): Boolean;
  1591. begin
  1592.   Result := (AItem is TSessionSprig) or
  1593.             (AItem is TImpliedSessionSprig) or
  1594.             (AItem is TDefaultSessionSprig);
  1595. end;
  1596.  
  1597. procedure TImpliedDatabaseSprig.FigureParent;
  1598. var
  1599.   vSessionName: string;
  1600.   vSession: TSprig;
  1601. begin
  1602.   // find real or default session
  1603.   vSessionName := SprigBDESessionName(FSessionName);
  1604.   vSession := Root.Find(vSessionName, False);
  1605.  
  1606.   // if not found see if its the default session
  1607.   if (vSession = nil) and
  1608.      (vSessionName = cDefaultSessionSprigName) then
  1609.     vSession := Root.Add(TDefaultSessionSprig.Create(nil));
  1610.  
  1611.   // still not found, try for an implied session
  1612.   if vSession = nil then
  1613.   begin
  1614.     vSession := Root.Find(SprigBDEImpliedSessionName(FSessionName), False);
  1615.  
  1616.     // if not make an implied session
  1617.     if vSession = nil then
  1618.     begin
  1619.       vSession := Root.Add(TImpliedSessionSprig.Create(nil));
  1620.       TImpliedSessionSprig(vSession).FSessionName := FSessionName;
  1621.     end;
  1622.   end;
  1623.  
  1624.   // put ourself here
  1625.   vSession.Add(Self);
  1626. end;
  1627.  
  1628. function TImpliedDatabaseSprig.ItemClass: TClass;
  1629. begin
  1630.   Result := TDatabase;
  1631. end;
  1632.  
  1633. function TImpliedDatabaseSprig.UniqueName: string;
  1634. begin
  1635.   Result := SprigBDEImpliedDatabaseName(FAlias);
  1636. end;
  1637.  
  1638. function TImpliedDatabaseSprig.Transient: Boolean;
  1639. begin
  1640.   Result := True;
  1641. end;
  1642.  
  1643. { TNestedTableSprig }
  1644.  
  1645. class function TNestedTableSprig.ParentProperty: string;
  1646. begin
  1647.   Result := 'DataSetField'; { do not localize }
  1648. end;
  1649.  
  1650. { TTableSprig }
  1651.  
  1652. function TTableSprig.AnyProblems: Boolean;
  1653. begin
  1654.   Result := inherited AnyProblems or
  1655.             (TTable(Item).TableName = '');
  1656. end;
  1657.  
  1658. function TTableSprig.Caption: string;
  1659. begin
  1660.   Result := CaptionFor(TTable(Item).TableName, UniqueName);
  1661. end;
  1662.  
  1663. { TQuerySprig }
  1664.  
  1665. function TQuerySprig.AnyProblems: Boolean;
  1666. begin
  1667.   Result := inherited AnyProblems or
  1668.             (TQuery(Item).SQL.Count = 0);
  1669. end;
  1670.  
  1671. { TStoredProcSprig }
  1672.  
  1673. function TStoredProcSprig.AnyProblems: Boolean;
  1674. begin
  1675.   Result := inherited AnyProblems or
  1676.             (TStoredProc(Item).StoredProcName = '');
  1677. end;
  1678.  
  1679. function TStoredProcSprig.Caption: string;
  1680. begin
  1681.   Result := CaptionFor(TStoredProc(Item).StoredProcName, UniqueName);
  1682. end;
  1683.  
  1684. { TTableMasterDetailBridge }
  1685.  
  1686. class function TTableMasterDetailBridge.GetOmegaSource(
  1687.   AItem: TPersistent): TDataSource;
  1688. begin
  1689.   Result := TTable(AItem).MasterSource;
  1690. end;
  1691.  
  1692. class function TTableMasterDetailBridge.OmegaIslandClass: TIslandClass;
  1693. begin
  1694.   Result := TTableIsland;
  1695. end;
  1696.  
  1697. class procedure TTableMasterDetailBridge.SetOmegaSource(AItem: TPersistent;
  1698.   ADataSource: TDataSource);
  1699. begin
  1700.   TTable(AItem).MasterSource := ADataSource;
  1701. end;
  1702.  
  1703. function TTableMasterDetailBridge.CanEdit: Boolean;
  1704. begin
  1705.   Result := True;
  1706. end;
  1707.  
  1708. function TTableMasterDetailBridge.Edit: Boolean;
  1709. var
  1710.   vPropEd: TTableFieldLinkProperty;
  1711. begin
  1712.   vPropEd := TTableFieldLinkProperty.CreateWith(TDataSet(Omega.Item));
  1713.   try
  1714.     vPropEd.Edit;
  1715.     Result := vPropEd.Changed;
  1716.   finally
  1717.     vPropEd.Free;
  1718.   end;
  1719. end;
  1720.  
  1721. function TTableMasterDetailBridge.Caption: string;
  1722. begin
  1723.   if TTable(Omega.Item).MasterFields = '' then
  1724.     Result := SNoMasterFields
  1725.   else
  1726.     Result := TTable(Omega.Item).MasterFields;
  1727. end;
  1728.  
  1729. { TQueryMasterDetailBridge }
  1730.  
  1731. function TQueryMasterDetailBridge.Caption: string;
  1732. begin
  1733.   Result := SParamsFields;
  1734. end;
  1735.  
  1736. class function TQueryMasterDetailBridge.GetOmegaSource(
  1737.   AItem: TPersistent): TDataSource;
  1738. begin
  1739.   Result := TQuery(AItem).DataSource;
  1740. end;
  1741.  
  1742. class function TQueryMasterDetailBridge.OmegaIslandClass: TIslandClass;
  1743. begin
  1744.   Result := TQueryIsland;
  1745. end;
  1746.  
  1747. class function TQueryMasterDetailBridge.RemoveMasterFieldsAsWell: Boolean;
  1748. begin
  1749.   Result := False;
  1750. end;
  1751.  
  1752. class procedure TQueryMasterDetailBridge.SetOmegaSource(AItem: TPersistent;
  1753.   ADataSource: TDataSource);
  1754. begin
  1755.   TQuery(AItem).DataSource := ADataSource;
  1756. end;
  1757.  
  1758. { TBatchMoveSprig }
  1759.  
  1760. function TBatchMoveSprig.AnyProblems: Boolean;
  1761. begin
  1762.   Result := (TBatchMove(Item).Destination = nil) or
  1763.             (TBatchMove(Item).Source = nil);
  1764. end;
  1765.  
  1766. function TBatchMoveSprig.Caption: string;
  1767. var
  1768.   vFrom, vTo: string;
  1769. begin
  1770.   if TBatchMove(Item).Source <> nil then
  1771.     vFrom := TBatchMove(Item).Source.Name
  1772.   else
  1773.     vFrom := '?';
  1774.   if TBatchMove(Item).Destination <> nil then
  1775.     vTo := TBatchMove(Item).Destination.Name
  1776.   else
  1777.     vTo := '?';
  1778.   Result := CaptionFor(Format('%s -> %s', [vFrom, vTo]), UniqueName); { do not localize }
  1779. end;
  1780.  
  1781. { TUpdateSQLSprig }
  1782.  
  1783. function TUpdateSQLSprig.AnyProblems: Boolean;
  1784. begin
  1785.   with TUpdateSQL(Item) do
  1786.     Result := (ModifySQL.Count = 0) and
  1787.               (InsertSQL.Count = 0) and
  1788.               (DeleteSQL.Count = 0);
  1789. end;
  1790.  
  1791. procedure Register;
  1792. begin
  1793.   { Database Components are excluded from the STD SKU }
  1794.   if GDAL <> LongWord(-16) then
  1795.   begin
  1796.     RegisterComponents(srDAccess, [TTable, TQuery, TStoredProc, TDatabase,
  1797.       TSession, TBatchMove, TUpdateSQL]);
  1798.     { Components that are excluded from the STD & PRO SKUs }
  1799.     if GDAL = 0 then
  1800.       RegisterComponents(srDAccess, [TNestedTable]);
  1801.     RegisterPropertyEditor(TypeInfo(string), TDatabase, 'AliasName', TAliasNameProperty);
  1802.     RegisterPropertyEditor(TypeInfo(string), TDatabase, 'DriverName', TDriverNameProperty);
  1803.     RegisterPropertyEditor(TypeInfo(string), TDatabase, 'SessionName', TSessionNameProperty);
  1804.     RegisterPropertyEditor(TypeInfo(string), TDBDataSet, 'SessionName', TSessionNameProperty);
  1805.     RegisterPropertyEditor(TypeInfo(string), TDBDataSet, 'DatabaseName', TDatabaseNameProperty);
  1806.     RegisterPropertyEditor(TypeInfo(TDataSetUpdateObject), TDataSet, 'UpdateObject', TComponentProperty);
  1807.     RegisterPropertyEditor(TypeInfo(TFileName), TTable, 'TableName', TTableNameProperty);
  1808.     RegisterPropertyEditor(TypeInfo(string), TTable, 'IndexName', TIndexNameProperty);
  1809.     RegisterPropertyEditor(TypeInfo(string), TTable, 'IndexFieldNames', TIndexFieldNamesProperty);
  1810.     RegisterPropertyEditor(TypeInfo(string), TTable, 'MasterFields', TTableFieldLinkProperty);
  1811.     RegisterPropertyEditor(TypeInfo(string), TStoredProc, 'StoredProcName', TProcedureNameProperty);
  1812.     RegisterPropertyEditor(TypeInfo(TParams), TQuery, 'Params', TQueryParamsProperty);
  1813.     RegisterPropertyEditor(TypeInfo(TParams), TStoredProc, 'Params', TStoredProcParamsProperty);
  1814.     RegisterPropertyEditor(TypeInfo(TStrings), TTable, 'IndexFiles', TIndexFilesProperty);
  1815.     RegisterPropertyEditor(TypeInfo(TCheckConstraints), TDBDataSet, 'Constraints', TCheckConstraintsProperty);
  1816.     RegisterComponentEditor(TDBDataset, TDBDataSetEditor);
  1817.     RegisterComponentEditor(TTable, TTableEditor);
  1818.     RegisterComponentEditor(TDatabase, TDatabaseEditor);
  1819.     RegisterComponentEditor(TBatchMove, TBatchMoveEditor);
  1820.     RegisterComponentEditor(TQuery, TQueryEditor);
  1821.     RegisterComponentEditor(TStoredProc, TStoredProcEditor);
  1822.     RegisterComponentEditor(TUpdateSQL, TUpdateSQLEditor);
  1823.  
  1824.     { Obsolete Components }
  1825.     {$IFNDEF DEVELOPERS}
  1826.       if HexDisplayPrefix = '$' then  // Only register TReport for Delphi
  1827.       begin
  1828.         RegisterComponents(srDAccess, [TReport]);
  1829.         RegisterPropertyEditor(TypeInfo(string), TReport, 'ReportDir', TReportDirProperty);
  1830.         RegisterPropertyEditor(TypeInfo(string), TReport, 'ReportName', TReportNameProperty);
  1831.         RegisterComponentEditor(TReport, TReportEditor);
  1832.       end;
  1833.       RegisterComponents(srWin31, [TDBLookupList, TDBLookupCombo]);
  1834.       RegisterNonActiveX([TDBLookupList, TDBLookupCombo], axrIncludeDescendants);
  1835.     {$ENDIF}
  1836.  
  1837.     { Property Category registration }
  1838.     RegisterPropertiesInCategory(TDatabaseCategory, TDBDataSet,
  1839.       ['DatabaseName', 'SessionName']);
  1840.  
  1841.     RegisterPropertiesInCategory(TDatabaseCategory, TDatabase,
  1842.       ['AliasName', 'DriverName', 'SessionName', 'DatabaseName']);
  1843.  
  1844.     { Property Category registration }
  1845.     RegisterPropertiesInCategory(TDatabaseCategory, TDataSetUpdateObject, ['*SQL']);
  1846.  
  1847.     RegisterSprigType(TSession, TSessionSprig);
  1848.     RegisterSprigType(TDatabase, TDatabaseSprig);
  1849.     RegisterSprigType(TNestedTable, TNestedTableSprig);
  1850.     RegisterSprigType(TBDEDataSet, TBDEDataSetSprig);
  1851.     RegisterSprigType(TDBDataSet, TDBDataSetSprig);
  1852.     RegisterSprigType(TTable, TTableSprig);
  1853.     RegisterSprigType(TQuery, TQuerySprig);
  1854.     RegisterSprigType(TStoredProc, TStoredProcSprig);
  1855.     RegisterSprigType(TBatchMove, TBatchMoveSprig);
  1856.     RegisterSprigType(TUpdateSQL, TUpdateSQLSprig);
  1857.  
  1858.     RegisterIslandType(TBDEDataSetSprig, TBDEDataSetIsland);
  1859.     RegisterIslandType(TDBDataSetSprig, TDBDataSetIsland);
  1860.     RegisterIslandType(TTableSprig, TTableIsland);
  1861.     RegisterIslandType(TQuerySprig, TQueryIsland);
  1862.  
  1863.     RegisterBridgeType(TDataSetIsland, TTableIsland, TTableMasterDetailBridge);
  1864.     //RegisterBridgeType(TDataSourceIsland, TTableIsland, TTableMasterDetailBridge);
  1865.     RegisterBridgeType(TDataSetIsland, TQueryIsland, TQueryMasterDetailBridge);
  1866.     //RegisterBridgeType(TDataSourceIsland, TQueryIsland, TQueryMasterDetailBridge);
  1867.   end;
  1868. end;
  1869.  
  1870. { TBDEDataSetSprig }
  1871.  
  1872. function TBDEDataSetSprig.GetDSDesignerClass: TDSDesignerClass;
  1873. begin
  1874.   Result := TBDEDesigner;
  1875. end;
  1876.  
  1877. end.
  1878.